import Prelude

-- El traductor se representa por un conjunto de estados "q",
--   - una funcion de transicion (primer parametro),
--   - una funcion de output (segundo parametro) y
--   - un estado inicial.
type Traductor q = (q -> Char -> q, q -> Char -> String, q)


-- EJEMPLO 1.1
-- Traductor que cambia las "a"s por "e"s y viceversa.
cambiarAE :: Traductor ()
cambiarAE = (const, g, ())
  where
    --g :: () -> Char -> String
      g () 'a' = "e"
      g () 'e' = "a"
      g ()  x  = [x]


-- EJERCICIO 1.2
-- Traductor que intercambia caracteres consecutivos.
-- Test1: (aplicando intercambiarConsecutivos "abcd1234xyz789") == "badc2143yx7z98" 
intercambiarConsecutivos :: Traductor (Maybe Char)
intercambiarConsecutivos = (f, g, Nothing)
  where
    --f :: (Maybe Char) -> Char -> (Maybe Char)
    f Nothing c = (Just c)
    f (Just x) c = Nothing
    --g :: (Maybe Char) -> Char -> String
    g Nothing c = []
    g (Just x) c  = maybe [] (\s -> c:[s]) (Just x)


-- EJEMPLO 1.3
-- Traductor que sea la identidad, salvo que nunca genera
-- salida output de las "a"s y, cuando aparece una "z",
-- muestra la "z" y luego todas las "a"s que se acumularon
-- juntas.
acumularAes :: Traductor Int
acumularAes = (f, g, 0)
  where
    --f :: Int -> Char -> Int
    f x 'a' = x + 1
    f x 'z' = 0
    f x  c  = x
    --g :: Int -> Char -> String
    g x 'z' = 'z':(replicate x 'a')
    g x 'a' = ""
    g x  c  = [c]


-- EJERCICIO 1.4
-- Traductor que de vuelta (ie. espeje) todo lo que esta
-- entre dos "a"s consecutivas.
-- pre: puedo asumir que termina en a o hay infinitas
-- Test2: (aplicando espejarEntreAs "123a456aa789a") == "321a654aa987a"
espejarEntreAs :: Traductor String
espejarEntreAs = (f, g, "")
  where
    --f :: String -> Char -> String
    f _ 'a' = ""
    f s c  = [c] ++ s
    --g :: String -> Char -> String
    g s 'a' = s ++ ['a']
    g s c = [ ]


-- Calcular la clausura de Kleene de la funcion de
-- transicion pasada como parametro
-- (version recursiva explicita).
fAst' :: (q -> Char -> q) -> q -> String -> q
fAst' f q0    ""  = q0
fAst' f q0 (c:cs) = fAst' f (f q0 c) cs
-- fAst f q0 "123"  = fAst f (f q0 "1") "23"
--                  = fAst f q1 "23" 
--                  = fAst f (f q1 "2") "3"
--                  = fAst f (f q2 "3") ""
--                  = fAst f q3 ""
-- EJERCICIO 1.5
-- Calcular la clausura de Kleene de la funcion de
-- transicion pasada como parametro
-- (version con esquemas de recursion).
-- Test3: (let (f,g,0) = acumularAes in (fAst f) 0 "cazaa") == 2
-- Test4: (let (f,g,0) = acumularAes in (fAst f) 0 "cazaaz") == 0
fAst :: (q -> Char -> q) -> q -> String -> q
fAst f q0 = foldl f q0
-- fAst f q0 "" = foldl f q0 "" = q0 
-- fAst f q0 "12" = foldl f q0 "12" = foldl f (f q0 '1') "2" = fold f 


-- Calcular la clausura de Kleene de la funcion de
-- salida pasada como parametro junto con la funcion
-- de transicion pasada como parametro
-- (version recursiva explicita).
gAst' :: (q -> Char -> q) -> (q -> Char -> String) -> q -> String -> String
gAst' f g q0    ""  = ""
gAst' f g q0 (c:cs) = (g q0 c) ++ gAst' f g (f q0 c) cs

-- EJERCICIO 1.6
-- Calcular la clausura de Kleene de la funcion de salida
-- pasada como parametro junto con la funcion de
-- transicion pasada como parametro
-- (version con esquemas de recursion).
-- Test5: (let (f,g,0) = acumularAes in (gAst f g) 0 "cazaa") == "cza"
-- Test6: (let (f,g,0) = acumularAes in (gAst f g) 0 "cazaaz") == "czazaa"

gAst :: (q -> Char -> q) -> (q -> Char -> String) -> q -> String -> String
gAst f g q0 cs = foldr (\t str -> (g (snd t) (fst t)) ++ str) "" (zip cs (scanl f q0 cs))
-- gAst f g q0 "123" = (g q0 '1') ++ (g (f q0 '1') '2') ++ (g (f (f q0 '1') '2') '3') ++ ""
-- gAst f g q0 "123" = (g q0 '1') ++ (g (fAst f q0 "1") '2') ++ (g (fAst f q0 "12") '3') ++ ""


-- EJEMPLO 1.7
-- Dado un traductor, retornar la funcion String -> String
-- que resulta al aplicarlo a cualquier entrada
-- Test7: (aplicando acumularAes "cazaa") == "cza"
-- Test8: (aplicando acumularAes "cazaaz") == "czazaa"
aplicando :: Traductor q -> String -> String
aplicando (f, g, q0) = gAst f g q0
--
aplicando2 :: Traductor q -> String -> String
aplicando2 (f, g, q0) = gAst' f g q0

-- EJERCICIO 1.8
-- Dados dos traductores, dar un traductor tal que la
-- funcion String -> String que denota el resultado, sea
-- justo la composicion de las funciones de cada
-- uno de los parametros.
-- Test9: aplicando (comp cambiarAE intercambiarConsecutivos) "abcd1234xyz789ee" == "bedc2143yx7z98aa" 
-- Test10: aplicando (comp espejarEntreAs cambiarAE) "123e456ee789e" == "321a654aa987a"
comp :: Traductor qq1 -> Traductor qq2 -> Traductor (qq1, qq2)
comp (f1, g1, q01) (f2, g2, q02) = (f, g, q0)
  where
    q0 = (q01, q02)
    --f :: (qq1, qq2) -> Char -> (qq1, qq2)
    -- En T2 avanzo al siguiente estado con f2
    -- En T1 avanzo según f1* aplicada a g2
    f x c = ((fAst f1 (fst x) (g2 (snd x) c)), (f2 (snd x) c))
    --g :: (qq1, qq2) -> Char -> String
    -- Uso g1* aplicada a g2
    g x c = aplicando (f1, g1, (fst x)) (g2 (snd x) c)


-- EJERCICIO 1.9
-- Dado un traductor, dar la cadena infinita que resulta de
-- procesar una lista infinita de "a"s (si se pide
-- "take n (salidaAes t)" no puede procesar infinitamente
-- para ningun "n")
-- Test11: take 4 (salidaAes intercambiarConsecutivos) == "aaaa"
-- Test12: take 5 (salidaAes cambiarAE) == "eeeee"
salidaAes :: Traductor q -> String
salidaAes t = aplicando t (repeat 'a') 


-- EJERCICIO 1.10
-- Decidir si es posible que el traductor dado de la salida
-- dada como segundo parametro
--
-- Usamos como entrada para el foldr una lista de todos los posibles 
-- Strings e que podrían producir s, teniendo en cuenta que 
-- 0 < |e| <= |s|
--
-- Test13: salidaPosible cambiarAE "0158" == True
-- Test14: salidaPosible intercambiarConsecutivos "0158" == True
-- Test14: salidaPosible intercambiarConsecutivos "01a58" == False
salidaPosible :: Traductor q -> String -> Bool
salidaPosible t s = foldr h False (concat (tail (take ((length s)+1) (iterate agregarNums [""]))))
    where h = (\x bs -> ((aplicando t x) == s) || bs)
--
-- agrega a todos los Strings de la entrada todos los caracteres numéricos
agregarNums :: [String] -> [String]
agregarNums = foldr f []
    where f = (\s ss -> (s++"0"):(s++"1"):(s++"2"):(s++"3"):(s++"4"):(s++"5"):(s++"6"):(s++"7"):(s++"8"):(s++"9"):ss)

-- Idea con recursión explícita
--salidaPosible t s = salidaPosibleAux t s (concat (tail (take ((length s)+1) (iterate agregarNums [""]))))
--salidaPosibleAux :: Traductor q -> String -> [String] -> Bool
--salidaPosibleAux t s [] = False
--salidaPosibleAux t s (x:xs) = ((aplicando t x) == s) || (salidaPosibleAux t s xs)


-- Para hacer pruebas
t1 = cambiarAE 
t2 = espejarEntreAs  
t3 = acumularAes
